Developer CD Series 1992 June: ROMin Holiday/ADC Developer CD (1992-06) (''ROMin Holiday'')_iso/Developer Connection - 06-1992.iso/Development Platforms/Apple II/Apple II Sample Code/APW.SC/SC23SoundEx/SoundEx.p

Text File | 1990-06-24 | 19.5 KB | 654 lines | [TEXT/pdos]

{
*   Standard Application Shell - Pascal Version - Modified for SoundEx
*
*       v3.0    Luther, Roberts
}

{
*
* Developer Technical Support Apple II Sample Code
*
*    Copyright (c) Apple Computer, Inc. 1989-1990
*               All Rights Reserved
**
*   This program and its derivatives are licensed only for
*   use on Apple computers.
*
*   Works based on this program must contain and
*   conspicuously display this notice.
*
*   This software is provided for your evaluation and to
*   assist you in developing software for the Apple IIGS
*   computer.
*
*   DISCLAIMER OF WARRANTY
*
*   THE SOFTWARE IS PROVIDED "AS IS" WITHOUT
*   WARRANTY OF ANY KIND, EITHER EXPRESS OR IMPLIED,
*   WITH RESPECT TO ITS MERCHANTABILITY OR ITS FITNESS
*   FOR ANY PARTICULAR PURPOSE.  THE ENTIRE RISK AS TO
*   THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
*   YOU.  SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU (AND
*   NOT APPLE OR AN APPLE AUTHORIZED REPRESENTATIVE)
*   ASSUME THE ENTIRE COST OF ALL NECESSARY SERVICING,
*   REPAIR OR CORRECTION.
*
*   Apple does not warrant that the functions
*   contained in the Software will meet your requirements
*   or that the operation of the Software will be
*   uninterrupted or error free or that defects in the
*   Software will be corrected.
*
*   SOME STATES DO NOT ALLOW THE EXCLUSION
*   OF IMPLIED WARRANTIES, SO THE ABOVE EXCLUSION MAY
*   NOT APPLY TO YOU.  THIS WARRANTY GIVES YOU SPECIFIC
*   LEGAL RIGHTS AND YOU MAY ALSO HAVE OTHER RIGHTS
*   WHICH VARY FROM STATE TO STATE.
}


program Shell;

uses
    Types,
    GSOS,
    Locator,
    ADB,
    IntMath,
    TextTool,
    Memory,
    SANE,
    ACE,
    Resources,
    MiscTool,
    Scheduler,
    Loader,
    Quickdraw,
    QDAux,
    Events,
    Controls,
    Windows,
    Menus,
    LineEdit,
    Dialogs,
    Sound,
    NoteSyn,
    NoteSeq,
    MIDI,
    StdFile,
    Scrap,
    Desk,
    Lists,
    Fonts,
    Print,
    TextEdit;


{ ParamRec contains the ParamText strings used in the static text controls. }

type ParamRec = RECORD
                    StrPtr  : array[0..9] of String255Ptr;
                    Str     : array[0..9] of String255;
                END;

{ CtlHiliteRec keeps track of which LineEdit controls are active.
  SoundEx will toggle between a LineEdit control and a static text
  control depending on whether the control is active or not,
  respectively }

     CtlHiliteRec = RECORD
                        docBlk : Boolean;
                        sndBlk : Boolean;
                        parm   : array[1..3] of Boolean;
                    END;

const
    MainWindowID = $1000;

    { menu item numbers for standard DA menu items }
    UndoID      = 250;
    CutID       = 251;
    CopyID      = 252;
    PasteID     = 253;
    ClearID     = 254;
    CloseID     = 255;

    { menu numbers }
    AppleMenuID     = $1100;    { 1st menu of 1st menu bar }
    FileMenuID      = $1200;    { 2nd menu of 1st menu bar }
    EditMenuID      = $1300;    { 3rd menu of 1st menu bar }
    SoundMenuID     = $1400;    { 4th menu of 1st menu bar }

    { application menu item numbers }
    AboutID         = AppleMenuID + 1;  { 1st item of 1st menu of 1st menu bar }
    QuitID          = FileMenuID  + 2;  { 2nd item of 2nd menu of 1st menu bar }

    { Sound pop-up menu item numbers. }
    SoundVersionID      = SoundMenuID + 4;
    SoundToolStatusID   = SoundMenuID + 6;
    FFGeneratorStatusID = SoundMenuID + 7;
    FFSoundDoneStatusID = SoundMenuID + 8;
    FFSoundStatusID     = SoundMenuID + 9;
    FFStartSoundID      = SoundMenuID + 10;
    FFStopSoundID       = SoundMenuID + 11;
    GetSoundVolumeID    = SoundMenuID + 12;
    GetTableAddressID   = SoundMenuID + 13;
    ReadRamBlockID      = SoundMenuID + 14;
    SetSoundMIRQVID     = SoundMenuID + 15;
    SetSoundVolumeID    = SoundMenuID + 16;
    SetUserSoundIRQVID  = SoundMenuID + 17;
    WriteRamBlockID     = SoundMenuID + 18;
    FFSetUpSoundID      = SoundMenuID + 19;
    FFStartPlayingID    = SoundMenuID + 20;
    SetDOCRegID         = SoundMenuID + 21;
    ReadDOCRegID        = SoundMenuID + 22;

    { staticText ID's which use paramText }
    curfileID           = 228;
    loadedAtID          = 229;
    buffSizeID          = 230;
    resultID            = 231;
    toolerrID           = 232;

    { LineEdit control ID's }
    oscGenTypeID        = 301;
    freqLow1ID          = 302;
    freqHigh1ID         = 303;
    vol1ID              = 304;
    tablePtr1ID         = 305;
    control1ID          = 306;
    tableSize1ID        = 307;
    freqLow2ID          = 308;
    freqHigh2ID         = 309;
    vol2ID              = 310;
    tablePtr2ID         = 311;
    control2ID          = 312;
    tableSize2ID        = 313;
    waveStartID         = 314;
    waveSizeID          = 315;
    freqOffsetID        = 316;
    docBufferID         = 317;
    bufferSizeID        = 318;
    nextWavePtrID       = 319;
    volSettingID        = 320;
    Parm1ID             = 321;
    Parm2ID             = 322;
    Parm3ID             = 323;

    execbut             = 350;
    loadbut             = 351;
    sndCmdPopUp         = 352;

    MyTaskMask      = $001FFFFF;{ handle all events possible }

    { resource ID numbers }
    BaseResID       = $00000000;    { start of resource ID numbers }
    MenuBarOneRID   = $00001000;    { resource ID of menu bar }

var
    { Standard global variables here }
    MyMemoryID      : integer;  { application's memory ID }
    Done            : boolean;  { flag to show when to quit application }
    ToolRecRef      : Ref;      { StartStopRecRef from StartUpTools }
    WindowKind      : integer;  { type of top window from GetWKind call }
    MenuHeight      : integer;  { stored height of menu bar }
    OurWindow       : WindowPtr;

    {   The following is the record that is used by TaskMaster to return
        events. It is similar to a regular event record, except that there are
        two additional fields at the end. The first is used to convey some
        TaskMaster specific data back to the application. The second is called
        the TaskMask and is used to tell TaskMaster what situations to handle.
        In this shell, we tell TaskMaster to handle everything by setting all
        currently defined bits to 1 (MyTaskMask) in the initApp procedure.  }

    MyEvent         : wmTaskRec;

    paramRec1       : ParamRec;

    BuffHndl        : Handle;
    BuffSize        : integer;

    CurCmdNum       : Integer;  {Current Menu Item (sound command) selected}
    CurCmdErr       : Integer;
    CurCmdResult    : Longint;
    ctlHilite       : CtlHiliteRec;
    parmArray       : packed array[oscGenTypeID..parm3ID] of String[8];

{$I SoundEx.inc.p}

{******************************************************************************
*
* errorCheck:   This procedure is declared forward. This lets you check for
*               fatal errors and still shut down fairly cleanly from
*               anywhere in your program.
}

procedure errorCheck(where : Integer);
    FORWARD;


{******************************************************************************
*
* doQuit:       Set the Done flag to true. This tells the Event loop to exit.
*
* Inputs:       NONE
* Outputs:      NONE
* Calls:        NONE
}

procedure doQuit;

begin
    Done := true;
end;


{******************************************************************************
*
* doAbout:      Bring up an Alert Dialog box with our name in it.
*
* Inputs:       NONE
* Outputs:      NONE
* Calls:        NONE
}

procedure doAbout;

const
    alertFlags  = 4;        { reference is a ResourceID }

var
    buttonHit   : integer;      { button number clicked }

begin
    buttonHit := AlertWindow(alertFlags,NIL,Pointer(BaseResID+1));
end;

{******************************************************************************
*
* doMenu:       This routine is called when TaskMaster returns a menu
*               event. It takes the menu item that was hit and calculates
*               an offset into the menu dispatch table. It then calls that
*               routine and unhilites the menu when it is done.
*
* Inputs:       TaskData holds menu item selected.
* Outputs:      NONE
* Calls:        doAbout, doQuit
}

procedure doMenu;

var
    menuNum,                    { ID of menu from which selection was made }
    itemNum     : integer;      { ID of selected menu item }

begin
    menuNum := HiWord(MyEvent.wmTaskData);  { get menu ID }
    itemNum := LoWord(MyEvent.wmTaskData);  { and item ID from MyEvent}

    case itemNum of
        AboutID             : doAbout;  { show About alert }
        QuitID              : doQuit;   { set Done flag }
        UndoID              :;
        CutID               :;
        CopyID              :;
        PasteID             :;
        ClearID             :;
    end;

        {   The routine has been called. Unhilite the menu and return to the
        Main Event Loop. }

    HiLiteMenu(false,menuNum);
end;

{******************************************************************************
*
* doSysChange:  Called by testTopWindow when the active window
*               has changed to or from a system window.
*
* Inputs:       Bit 15 of WindowKind is 0 if top window is an application
*               window, 1 if top window is a system window.
* Outputs:      NONE
* Calls:        NONE
}

procedure doSysChange;

begin
    if Band(WindowKind,$8000) <> 0 { if bit 15 of WindowKind = 1, MPW Pascal call! }
        then
            begin
                { enable the edit menu items and the close item }
                EnableMItem(UndoID);
                EnableMItem(CutID);
                EnableMItem(CopyID);
                EnableMItem(PasteID);
                EnableMItem(ClearID);
                EnableMItem(CloseID);

                { if your edit menu has items that are selectable when a
                  NDA is not the active window, remove the next two lines. }
                SetMenuFlag(enableMenu,EditMenuID);
                DrawMenuBar;
            end
        else
            begin
                { disable the edit menu items and the close item }
                DisableMItem(UndoID);
                DisableMItem(CutID);
                DisableMItem(CopyID);
                DisableMItem(PasteID);
                DisableMItem(ClearID);
                DisableMItem(CloseID);

                { if your edit menu has items that are selectable when a
                  NDA is not the active window, remove the next two lines. }
                SetMenuFlag(disableMenu,EditMenuID);
                DrawMenuBar;
            end;
end;


{******************************************************************************
*
* testTopWindow:This routine is called on every time through the event loop.
*               If the type to the top window has changed from application
*               window to system window or back, this routine will call
*               doSysChange.
*
* Inputs:       NONE
* Outputs:      NONE
* Calls:        doSysChange
}

procedure testTopWindow;

var
    tempWindowPtr   : WindowPtr;    { active window's grafPort }
    tempWindowKind  : integer;  { active window's kind }

begin
    tempWindowPtr := FrontWindow;   { get active window's grafPort }

    if tempWindowPtr <> NIL     { if there is an active window }
        then tempWindowKind := GetWKind(tempWindowPtr) { get its kind }
        else tempWindowKind := 0; { force to application window kind }

    if tempWindowKind <> WindowKind
        then                    { window kind has changed }
            begin               { save the WindowKind and change the menus }
                WindowKind := tempWindowKind;
                doSysChange;
            end;
end;


procedure DrawThisWindow;
    begin
        WaitCursor;
        DrawControls(GetPort);
        InitCursor;
        if FlushEvents(6, 0) <> 6 then begin end;
    END;

{******************************************************************************
*
* closeTools:   Shut down the tools I started.
*
* Inputs:       NONE
* Outputs:      NONE
* Calls:        NONE
}

procedure closeTools;

begin
    { shut down tools started by StartUpTools }
    ShutDownTools(refIsHandle,ToolRecRef);

    { shut down Memory Manager and Tool Locator }
    MMShutDown(MyMemoryID);
    TLShutDown;
end;


{******************************************************************************
*
* closeApp:     Close down things. This disposes of all items and
*               memory that we allocated. Usually undoes what was done
*               in initApp.
*
* Inputs:       NONE
* Outputs:      NONE
* Calls:        NONE
}

procedure closeApp;

begin
    CloseWindow(FrontWindow);
end;


{******************************************************************************
*
* eventLoop:    Main Event Loop. Handle things until user selects Quit.
*
* Inputs:       NONE
* Outputs:      NONE
* Calls:        testTopWindow, doMenu
}

procedure eventLoop;

var
    taskCode    : integer;      { code indicating action to be taken }

begin
    repeat
        testTopWindow;          { test top window to see if it is a NDA }

        taskCode := TaskMaster(EveryEvent,MyEvent);
        case taskCode of        { handle the event for this taskcode }
            {   With most of these events, we do nothing (in fact, most
                applications will never see some of these events). You
                should cut the labels for events your application does
                not use out of this case statement. Any of these events
                your application does use should call a procedure to handle
                the event.  }
            nullEvt:;
            mouseDownEvt:;
            mouseUpEvt:;
            keyDownEvt:;
            autoKeyEvt:;
            updateEvt:;
            activateEvt:;
            switchEvt:;
            deskAccEvt:;
            driverEvt:;
            app1Evt:;
            app2Evt:;
            app3Evt:;
            app4Evt:;
            wInDesk:;
            wInMenuBar,             { do "In system menu bar" events and }
            wInSpecial: doMenu;     { "Item ID selected was 250-255" events }
            wClickCalled:;
            wInContent:;
            wInDrag:;
            wInGrow:;
            wInGoAway:;
            wInZoom:;
            wInInfo:;
            wInDeskItem:;
            wInFrame:;
            wInactMenu:;
            wClosedNDA:;
            wCalledSysEdit:;
            wTrackZoom:;
            wHitFrame:;
            wInControl: doInControl;
            wInControlMenu:;
        end;
    until Done;                     { Loop until "Quit" is selected }
end;

procedure OpenTheWindow;

begin
    OurWindow := NewWindow2(NIL,0,@DrawThisWindow,NIL,2,ref(MainWindowID),
                            rWindParam1);
    ShowWindow(OurWindow);
    SelectWindow(OurWindow);
    hiliteDocBlk;
    hiliteSndBlk;
    hiliteParmX(1,'');
    hiliteParmX(2,'');
    hiliteParmX(3,'');
end;




{******************************************************************************
*
* initApp:      Perform any application specific initialization. For
*               this app,  we do is initialize the Done to false,
*               set WindowKind to an application window kind, initialize all
*               of the menus and initialize the TaskMask in the event record.
*               You might use this procedure to create windows,
*               initialize variables and allocate memory needed for
*               the entire program.
*
* Inputs:       NONE
* Outputs:      NONE
* Calls:        NONE
}

procedure initApp;

begin
    Done := false;              { we aren't done yet }

    WindowKind := 0;            { window kind  = application }

    { tell TaskMaster what events to handle }
    MyEvent.wmTaskMask := MyTaskMask;

    { create default system menu bar from a resource
      and make it the current menu bar }

    SetSysBar(NewMenuBar2(refIsResource,Ref(MenuBarOneRID),NIL));
    SetMenuBar(NIL);
    WaitCursor;

    InitSoundEx;

    RefreshDeskTop(NIL);        { redraw the desktop }

{   InitCursor;                  normal arrow cursor }

    FixAppleMenu(AppleMenuID);  { add NDAs to Apple menu }
    MenuHeight := FixMenuBar;   { set menu bar height }
    DrawMenuBar;                { draw the menu bar }
    OpenTheWindow;              { Open our one and only window }
    InitCursor;
    if FlushEvents(6, 0) <> 6 then begin end;
end;


{******************************************************************************
*
* errorCheck:   This routine is called by initTools to check for startup
*               errors. An error message is shown and everything is
*               shut down if any errors are detected.
*
* Inputs:       where = the a reference number that tells you where in the
*               initTools procedure the error happened.
* Outputs:      NONE (program exits)
* Calls:        closeTools
}

procedure errorCheck(where : Integer);

var
    theError    : integer;      { the tool error number }
    errStr      : str255;       { string to display error message }
    tempChar    : integer;      { temp to eat character returned }

begin
    if _toolErr <> 0 { _toolErr is an external var }
        then
            begin
                theError := _toolErr;   { store the error number }

                { initialize errStr }
                errStr :=
            'Fatal Error $0000 has occurred at xxxx. Press any key to exit:';

                { Stick error # into a string }
                Int2Hex(theError,Pointer(Ord4(@errStr)+14),4);

                { Stick loc # into a string }
                Int2Hex(where,Pointer(Ord4(@errStr)+35),4);

                GrafOff;                        { turn off super Hires }
                WriteLine(errStr);              { write errStr to text screen }
                SysBeep;                        { ring the bell }
                tempChar := ReadChar(noEcho);   { & wait for keypress }

                closeTools;     { ShutDown my Tools }
                Halt;           { quit with APW status = 1, MPW Pascal call! }
            end;
end;


{******************************************************************************
*
* initTools:    Load and startup the tools needed. errorCheck is called
*               after each startup to check for errors.
*
* Inputs:       NONE
* Outputs:      NONE
* Calls:        errorCheck
}

procedure initTools;

begin
    TLStartUp;                  { start up Tool Locator }
    errorCheck(1);              { Make sure all is OK }

    MyMemoryID := MMStartUp;    { start up Memory Manager & get Memory ID }
    errorCheck(2);              { Make sure all is OK }

    { start up the rest of the tools }
    ToolRecRef := StartUpTools(MyMemoryID,refIsResource,Ref(BaseResID+1));
    errorCheck(3);              { Make sure all is OK }
end;


{******************************************************************************
*
* main:         This is the main routine. It calls procedures to startup
*               the tools, initialize application specific data, run the
*               main eventLoop, close the application, and shutdown the tools.
*
* Inputs:       NONE
* Outputs:      NONE
* Calls:        initTools, initApp, eventLoop, closeApp, closeTools
}

begin
    initTools;              { Initialize tools. }
    initApp;                { Initialize application specific stuff. }

    eventLoop;              { Do application stuff until user wants to
                              do something else! }

    closeApp;               { ShutDown application specific things. }
    closeTools;             { ShutDown the tools. }
end.